COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	GENERAL PURPOSE TEST ROUTINE USING THE KERNEL
C00004 00003	FLREAD, SCALIN, VECTIN, TRNSIN, SCLOUT, VECOUT, TRNOUT
C00010 00004	 program initialization
C00014 ENDMK
C⊗;
;GENERAL PURPOSE TEST ROUTINE USING THE KERNEL

	.MACRO SYSDEF ADR, CONTEN
	III == .
	. = ADR
	CONTEN
	. = III
	.ENDM

.INSRT KDEF.PAL[11,SYS]
.INSRT HALHED.PAL[HAL,HE]
.INSRT HALIO.PAL[HAL,HE]
.INSRT HALRTR.PAL[HAL,HE]
;INSRT GRAPHS.PAL[HAL,HE]
;INSRT FBUG.PAL[1,BES]
;INSRT ARITH.PAL[HAL,HE]
.INSRT INTERP.PAL[HAL,HE]
INSTRT = 44000

;Data areas
ARG1:	.BLKW 32.	;Long enough for a trans
ARG2:	.BLKW 32.	;Long enough for a trans
RES:	.BLKW 32.	;Long enough for a trans
CURIN:	INBUF		;Current line pointer
	.BLKW 100	;Stack
STACK:	.BLKW 1		;
	TELL ISBS
ISTBLK:	.BLKW ISBS	;Interpreter status block
ENVIRO:	.BLKW 100	;Environment
INSTCK:	.BLKW INSTSZ	;Interpreter Stack

	PDBLK MAINBL,100,S	;Makes a process descriptor for main process

	SYSDEF JOBDAT, MAINBL
	SYSDEF JOBSA, START
	SYSDEF JOBPDL, STACK
;FLREAD, SCALIN, VECTIN, TRNSIN, SCLOUT, VECOUT, TRNOUT

;Routine to read a floating number into location pointed to by R0.
FLREAD:	MOV R0,-(SP)	;Save arg.
	MOV CURIN,R0	;R0 ← current line pointer
FLRD2:	JSR PC,RELSCN	;AC0 ← number typed in
	TST R1		;Got anything?
	BEQ FLRD1	;Yes.
	MOV #INBUF,R0	;No.  Prepare to read a new line.
	JSR PC,INSTR	;
	MOV #INBUF,R0	;
	BR FLRD2	;
FLRD1:	MOV R0,CURIN	;New current line pointer
	STF AC0,@(SP)+	;Put number in desired place.
	RTS PC		;Done

;Routine to get a scalar argument into arg1 or arg2, whichever R0 points to
SCALIN:	OUTSTR SCLMES	;Say we want a scalar
	MOV R0,-(R3)	;Stack the argument
	CLRB @CURIN	;Force a move to new line.
	JSR PC,FLREAD	;Read it.
	RTS PC		;Done
SCLMES:	ASCIE </SCALAR, PLEASE: />
	
;Routine to get a vector argument into arg1 or arg2, whichever R0 points to
VECTIN:	MOV R2,-(SP)	;Save R2
	OUTSTR VCTMES	;Say we want a vector
	MOV R0,-(R3)	;Stack the destination
	MOV R0,-(SP)	;and save a copy on the other stack, too.
	CLRB @CURIN	;Force a move to new line.
	MOV #4,R2	;Need to read 4 scalars
VCTIN1:	JSR PC,FLREAD	;Get one
	MOV (SP),R0	;Retrieve location
	ADD #4,R0	;Update location
	MOV R0,(SP)	;Save it again
	SOB R2,VCTIN1	;Go back and pick up other fields
	TST (SP)+	;Clean off stack
	MOV (SP)+,R2	;Restore R2.
	RTS PC		;Done
VCTMES:	ASCIE </I NEED A VECTOR.  GIVE ME 4 SCALARS, PLEASE:
/>

;Routine to get a trans argument into arg1 or arg2, whichever R0 points to
TRNSIN:	MOV R2,-(SP)	;Save R2
	OUTSTR TRNMES	;Say we want a vector
	CLRB @CURIN	;Force a move to new line.
	MOV R0,-(R3)	;Stack the destination
	MOV R0,-(SP)	;and save a copy on the other stack, too.
	MOV #16.,R2	;Need to read 16 scalars
TRNSN1:	JSR PC,FLREAD	;Get one
	ADD #4,(SP)	;Update location
	MOV (SP),R0	;  and retrieve it.
	SOB R2,TRNSN1	;Go back and pick up other fields
	TST (SP)+	;Clean off stack
	MOV (SP)+,R2	;Restore R2.
	RTS PC		;Done
TRNMES:	ASCIE </I NEED A TRANS.  16 SCALARS, BY  πC O L U M N S:
/>

;Routine to print the scalar argument pointed to by R0
SCLOUT:	LDF (R0),AC0	;Pick up number.
	MOV #OUTBUF,R0	;
	JSR PC,CVG	;Convert it to string
	MOV #OUTBUF,R0	;
	JSR PC,TYPSTR	;Print it.
	RTS PC		;Done

;Routine to print the vector argument pointed to by R0
VECOUT:	MOV R2,-(SP)	;Save R2
	MOV R3,-(SP)	;Save R3
	MOV R0,R2	;R2 ← LOC[next field]
	MOV #4,R3	;Need to print 4 fields
VCOUT1:	LDF (R2)+,AC0	;Pick up a field
	MOV #OUTBUF,R0	;
	JSR PC,CVG	;Convert it to string
	MOV #OUTBUF,R0	;
	JSR PC,TYPSTR	;Print it.
	SOB R3,VCOUT1	;Do all this 4 times
	MOV (SP)+,R3	;Restore R3
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;Routine to print the trans argument pointed to by R0
TRNOUT:	MOV R2,-(SP)	;Save R2
	MOV R3,-(SP)	;Save R3
	MOV R4,-(SP)	;Save R4
	MOV R0,R2	;R2 ← LOC[next field]
	MOV #4,R4	;Need to print 4 cols
TNOUT2:	MOV #4,R3	;Need to print 4 rows
TNOUT1:	LDF (R2)+,AC0	;Pick up a field
	MOV #OUTBUF,R0	;
	JSR PC,CVG	;Convert it to string
	MOV #OUTBUF,R0	;
	JSR PC,TYPSTR	;Print it.
	SOB R3,TNOUT1	;Do all this 4 times
	CRLF		;
	SOB R4,TNOUT2	;Do this for all 4 cols.
	MOV (SP)+,R4	;Restore R4
	MOV (SP)+,R3	;Restore R3
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

; program initialization
	PDBSTA	== 40	;Process Descriptor Block Status Word
	PDBR0	== 60	;Where R0 is saved
	PDBR1	== 62	;Where R1 is saved
	PDBR2	== 64	;Where R2 is saved
	PDBR3	== 66	;Where R3 is saved
	PDBR4	== 70	;Where R4 is saved
	PDBR5	== 72	;Where R5 is saved
	PDBSP	== 74	;Where SP is saved
	PDBPC	== 76	;Where PC is saved
	PDBSSV	== 104	;Process Descriptor Block Stack Save Length Word
START:	
	MOV #16,R0	;Field length
	MOV #10,R1	;Decimal digits
	JSR PC,FORMAT	;
	MOV #STACK,R3	;Set up argument stack
	JSR PC,FRINIT	;Initialize free storage

	EVMAK		;-(SP) ← event
	MOV #ISBS,R0	;R0 ← Size (in words) of an interpreter status block
	JSR PC,GTFREE	;R0 ← LOC[new interpreter status block]
	CLR LEV(R0)	;new LEV ← 0
	MOV #INSTRT,IPC(R0)	;new IPC ← interpreter start address
	MOV #ENVIRO,ENV(R0)	;new ENV ← ENVIRO
	MOV (SP),EVT(R0);new EVT ← event just created.
	MOV R0,-(SP)	;Save LOC[new interpreter status block]
	MOV #INSTSZ,R0	;R0 ← Size needed for an interpreter stack
	JSR PC,GTFREE	;R0 ← LOC[new interpreter stack]
	MOV (SP)+,R1	;R1 ← LOC[new interpreter status block]
	MOV R0,STKBAS(R1)	;Store away new stack base
	ADD #2*INSTSZ,R0	;R0 ← LOC[top of new stack] (INSTSZ is in bytes)
	MOV R1,-(SP)	;Save R1
	MOV R0,-(SP)	;Save R0
	MOV #210,R0	;Room for process descriptor
	JSR PC,GTFREE	;R0 ← LOC[new process descriptor]
	MOV #UFPUSE+UGPSAV,PDBSTA(R0);Use floating point, use saved registers.
	MOV #100,PDBSSV(R0)	;Length of stack to be saved.
	MOV (SP)+,R1	;R1 ← LOC[new interpreter stack top]
	MOV R1,PDBR3(R0)	;Store away new interp stack pointer (reg 3)
	MOV (SP)+,R1		;R1 ← LOC[new ISB]
	MOV R0,PCB(R1)		;Store away LOC[PCB] in new ISB
	MOV R1,PDBR4(R0)	;Store away LOC[ISB] in reg 4 of PCB
	MOV SP,R1	;
	TST (R1)+	;
	MOV R1,PDBSP(R0)	;Store away the new stack pointer (reg 6)
	MOV #INTERP,PDBPC(R0);Store away the new PC
	ADD #PDBSTA,R0	;Move R0 to the middle of the process descriptor
	SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
	EVWAIT (SP)	;Wait for the return signal
	BCC  TST1	;All well?
	HALERR TSTMES	;No
TST1:	OUTSTR TSTME1	;Say farewell
	DISMIS		;Go away
TSTMES: ASCIE </BAD RETURN FROM MAIN INTERPRETER
/>
TSTME1: ASCIE </
ALL DONE NOW.  SEE YOU AROUND!
/>

PATCH:  .BLKW 100

.END START